home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgLangD.iso / TURBOPASCAL WIN / RWDEMOS.PAK / BITBNAPP.PAS next >
Pascal/Delphi Source File  |  1992-06-08  |  3KB  |  118 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows                     }
  4. {   Demo program                                 }
  5. {   Copyright (c) 1992 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. { This program uses a DLL that implements custom controls.
  10.   Make sure you build the DLL (BITBTN.PAS) before running
  11.   this program. }
  12.  
  13. program BitBnApp;
  14.  
  15. {$R BitBnApp.RES}
  16.  
  17. uses WinTypes, WinProcs, WObjects, Win31;
  18.  
  19. const
  20.   DLLName = 'BITBTN.DLL';
  21.  
  22. const
  23.   em_DLLNotFound = 1;
  24.  
  25. type
  26.   PBitWindow = ^TBitWindow;
  27.   TBitWindow = object(TDlgWindow)
  28.     procedure Yes(var Msg: TMessage);
  29.       virtual id_First + id_Yes;
  30.     procedure No(var Msg: TMessage);
  31.       virtual id_First + id_No;
  32.     procedure Ok(var Msg: TMessage);
  33.       virtual id_First + id_OK;
  34.     procedure Cancel(var Msg: TMessage);
  35.       virtual id_First + id_Cancel;
  36.   end;
  37.  
  38.   PBitApp = ^TBitApp;
  39.   TBitApp = object(TApplication)
  40.     Lib: THandle;
  41.     constructor Init(AName: PChar);
  42.     destructor Done; virtual;
  43.     procedure InitMainWindow; virtual;
  44.     procedure Error(ErrorCode: Integer); virtual;
  45.   end;
  46.  
  47. { TBitApp }
  48.  
  49. constructor TBitApp.Init(AName: PChar);
  50. begin
  51.   { Tell Windows not to display a 'DLL not found' error
  52.     dialog if the LoadLibrary function fails.  We'll handle
  53.     the error and inform the user ourselves.
  54.     Note that even though this SEM_ constant is defined and
  55.     documented only in Windows 3.1, it actually works in
  56.     Windows 3.0 as well... }
  57.   SetErrorMode(SEM_NoOpenFileErrorBox);
  58.   Lib := LoadLibrary(DLLName);
  59.   if Lib < 32 then
  60.     Status := em_DLLNotFound
  61.   else
  62.     TApplication.Init(AName);
  63. end;
  64.  
  65. destructor TBitApp.Done;
  66. begin
  67.   TApplication.Done;
  68.   FreeLibrary(Lib);
  69. end;
  70.  
  71. procedure TBitApp.InitMainWindow;
  72. begin
  73.   MainWindow := New(PBitWindow, Init(nil, MakeIntResource(100)));
  74. end;
  75.  
  76. procedure TBitApp.Error(ErrorCode: Integer);
  77. begin
  78.   case ErrorCode of
  79.     em_DLLNotFound:
  80.       MessageBox(0, DLLName + ' not found. Please compile BITBTN.PAS ' +
  81.         'before executing this application.', 'Fatal error',
  82.         mb_Ok or mb_IconStop);
  83.   else
  84.     TApplication.Error(ErrorCode);
  85.   end;
  86. end;
  87.  
  88. { TBitWindow }
  89.  
  90. procedure TBitWindow.Yes(var Msg: TMessage);
  91. begin
  92.   CloseWindow;
  93. end;
  94.  
  95. procedure TBitWindow.No(var Msg: TMessage);
  96. begin
  97.   CloseWindow;
  98. end;
  99.  
  100. procedure TBitWindow.Ok(var Msg: TMessage);
  101. begin
  102.   CloseWindow;
  103. end;
  104.  
  105. procedure TBitWindow.Cancel(var Msg: TMessage);
  106. begin
  107.   CloseWindow;
  108. end;
  109.  
  110. var
  111.   App: TBitApp;
  112.  
  113. begin
  114.   App.Init('TBITBTN.DDL Demo');
  115.   App.Run;
  116.   App.Done;
  117. end.
  118.